home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
graphic
/
shwpcx10.zip
/
SHOWPCX.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-12-30
|
28KB
|
810 lines
Program showpcx;
{ Free Software by TapirSoft Gisbert W.Selke, Dec 1991 }
{$A+,B-,D+,E+,F-,I-,L+,N-,O-,V- }
{$M 65520,0,128000 }
{$UNDEF DEBUG } { DEFINE while debugging }
{$IFDEF DEBUG }
{$R+,S+ }
{$ELSE }
{$R-,S- }
{$ENDIF }
Uses Graph, CRT, Dos;
Const progname = 'ShowPCX';
version = '1.0';
copyright= 'Free Software by TapirSoft Gisbert W.Selke, Dec 1991';
bufsize = 60000;
maxlinlen= 2048; { maximum length of screen line }
Tab = #9;
finishset: Set Of char = [#3,#27,'q','Q'];
Type headrec = Record
id : byte; { must be $0A }
version : byte; { 0, 2, 3, or 5 }
compr : byte; { 1 if RLE-coded }
bitsperpixel : byte;
xmin : word;
ymin : word;
xmax : word;
ymax : word;
horidpi : word; { horizontal resolution, dots per inch }
vertdpi : word; { vertical resolution, dots per inch }
colormap : Array [0..15,0..2] Of byte;
reserved : byte;
ncolplanes : byte; { number of colour planes; max 4 }
bytesperline : word; { must be even }
greyscale : word; { 1 if colour or b/w; 2 if greyscale }
filler : Array [1..58] Of byte;
End;
buffer = Array [1..bufsize ] Of byte;
linbuffer= Array [0..maxlinlen] Of byte;
Var listf : text;
inbufptr : ^buffer;
sr : SearchRec;
saveexit : Pointer;
dir, picname : string;
grdriver, grmode : integer;
maxx, maxy, maxcolour, deltime : word;
parampt, xscale, yscale, videomode : byte;
zverbose, zxcentre, zycentre, zprop, zmono, zconj, zebra : boolean;
zquiet, zgraph, zlist, zfirst, zfinish, zfound, zrepeat : boolean;
{ Link in graphics drivers for EGA, VGA and Hercules: }
Procedure egavga_driver; External;
{$L EGAVGA.OBJ }
Procedure svga256_driver; External;
{$L SVGA256.OBJ }
Procedure herc_driver; External;
{$L HERC.OBJ }
{$F+} function DetectVGA256 : integer; {$F-}
var
DetectedDriver : integer;
SuggestedMode : integer;
begin
DetectGraph(DetectedDriver, SuggestedMode);
DetectVGA256 := SuggestedMode;
if (DetectedDriver = VGA) or (DetectedDriver = MCGA) then
DetectVGA256 := 0 { Default video mode = 0 }
else
DetectVGA256 := grError; { Couldn't detect hardware }
end; { DetectVGA256 }
{$F+ } Procedure myexit; {$F- }
{ exit procedure to clean things up }
Var c : char;
Begin { myexit }
ExitProc := saveexit;
NoSound;
If zgraph Then
Begin
SetGraphMode(GetGraphMode);
CloseGraph;
zgraph := False;
End;
If Not zfound Then writeln('No matching PCX files found.');
While KeyPressed Do c := ReadKey;
End; { myexit }
Procedure beep;
{ emit a short beep }
Begin { beep }
If Not zquiet Then
Begin
Sound(440);
Delay(50);
NoSound;
End;
End; { beep }
Procedure abort(msg : string; ierr : byte);
{ show error message and die }
Begin { abort }
If zgraph Then CloseGraph;
zgraph := False;
If msg <> '' Then writeln(progname,': ',msg);
Halt(ierr);
End; { abort }
Procedure usage;
{ show usage hints and die }
Begin { usage }
writeln;
writeln(progname,' ',version,': display PCX files on screen');
writeln(copyright);
writeln;
writeln('Usage: ',progname,' [<options>] <filespec> [<filespec>...]');
writeln(' where <filespec> is the name of a PCX file, possibly ',
'containing');
writeln(' wildcard characters (default extension .PCX),');
writeln(' or "@", followed immediately by the name of a file ');
writeln(' containing names of PCX files.');
writeln(' Options: /c : centre image');
writeln(' /cx : centre image horizontally');
writeln(' /cy : centre image vertically');
writeln(' /d<num> : delay in milliseconds after each ',
'image');
writeln(' /e<num> : extended VGA mode (use at your own ',
'risk!)');
writeln(' /h : display help');
writeln(' /m : force monochrome mode');
writeln(' /p : use alternate packing strategy for scaling');
writeln(' /q : quiet behaviour (don''t beep)');
writeln(' /r : repeat indefinitely');
writeln(' /s<num> : scale image by factor ',
'1/<num> (0 = autoscale)');
writeln(' /sx<num> : scale horizontally only');
writeln(' /sy<num> : scale vertically only');
writeln(' /v : verbose image info');
writeln(' /z : zebra monochrome mode');
zfound := True;
abort('',1);
End; { usage }
Procedure strip(Var s : string);
{ remove leading and trailing white space }
Begin { strip }
While (s <> '') And (s[1] In [' ',Tab]) Do Delete(s,1,1);
While (s <> '') And (s[Length(s)] In [' ',Tab]) Do Delete(s,Length(s),1);
End; { strip }
Function getnextname : string;
{ get name of next file to display }
Var temp, nam, ext : string;
doserr : integer;
Begin { getnextname }
sr.name := '';
doserr := 0;
If zfirst Then
Begin
temp := '';
While zlist And (temp = '') Do
Begin
If EoLn(listf) And (Not EoF(listf)) Then readln(listf);
If IOResult <> 0 Then;
If zlist And EoF(listf) Then
Begin
Close(listf);
Dispose(inbufptr);
zlist := False;
End;
If zlist Then read(listf,temp);
If IOResult <> 0 Then;
strip(temp);
End;
If temp = '' Then
Begin
While (temp = '') And (parampt <= ParamCount) Do
Begin
If (parampt = ParamCount) And zrepeat And zfound Then parampt := 0;
Inc(parampt);
If parampt <= ParamCount Then temp := ParamStr(parampt);
If temp[1] In ['-','/'] Then temp := '';
End;
If temp[1] = '@' Then
Begin
Assign(listf,Copy(temp,2,255));
Reset(listf);
If IOResult <> 0 Then;
New(inbufptr);
SetTextBuf(listf,inbufptr^);
zlist := True;
temp := getnextname;
End;
End;
If temp <> '' Then
Begin
FSplit(temp,dir,nam,ext);
If ext = '' Then ext := '.PCX';
temp := dir + nam + ext;
FindFirst(temp,ReadOnly+Hidden+SysFile+Archive,sr);
doserr := DosError;
If doserr = 0 Then zfound := True;
zfirst := False;
End
Else
Begin
dir := '';
sr.name := '';
End;
End
Else
Begin
FindNext(s